TakeHome 5

library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.0     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.1
✔ purrr     1.0.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

atp_rankings <- read_csv("https://raw.githubusercontent.com/JeffSackmann/tennis_atp/master/atp_rankings_20s.csv")

Rows: 332942 Columns: 4
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
dbl (4): ranking_date, rank, player, points

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

atp_rankings_10s <- read_csv("https://raw.githubusercontent.com/JeffSackmann/tennis_atp/master/atp_rankings_10s.csv")

Rows: 915618 Columns: 4
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
dbl (4): ranking_date, rank, player, points

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

atp_players <- read_csv("https://raw.githubusercontent.com/JeffSackmann/tennis_atp/master/atp_players.csv")

Rows: 64759 Columns: 8
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (5): name_first, name_last, hand, ioc, wikidata_id
dbl (3): player_id, dob, height

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

df10s <- left_join(atp_rankings_10s, atp_players,
                   join_by(player == player_id))
df20s <- left_join(atp_rankings, atp_players,
                   join_by(player == player_id))

atp_top50_ever <- bind_rows(df10s, df20s) |>
  filter(rank <= 50)

atp_rank <- bind_rows(df10s, df20s) |>
  semi_join(atp_top50_ever, join_by(player == player)) |>
  unite(name, c("name_first", "name_last"), sep = " ") |>
  mutate(ranking_date = lubridate::ymd(ranking_date)) |>
  complete(name, ranking_date, fill = list(points = 0)) |> 
  arrange(ranking_date, desc(points))
## what do you think complete() is doing here? 

atp_rank

# A tibble: 144,729 × 10
   name   ranking_date  rank player points hand     dob ioc   height wikidata_id
   <chr>  <date>       <dbl>  <dbl>  <dbl> <chr>  <dbl> <chr>  <dbl> <chr>      
 1 Roger… 2010-01-04       1 103819  10550 R     1.98e7 SUI      185 Q1426      
 2 Rafae… 2010-01-04       2 104745   9205 L     1.99e7 ESP      185 Q10132     
 3 Novak… 2010-01-04       3 104925   8310 R     1.99e7 SRB      188 Q5812      
 4 Andy … 2010-01-04       4 104918   7030 R     1.99e7 GBR      190 Q10125     
 5 Juan … 2010-01-04       5 105223   6785 R     1.99e7 ARG      198 Q180535    
 6 Nikol… 2010-01-04       6 103786   4930 R     1.98e7 RUS      178 Q191736    
 7 Andy … 2010-01-04       7 104053   4410 R     1.98e7 USA      188 Q54584     
 8 Robin… 2010-01-04       8 104417   3410 R     1.98e7 SWE      193 Q192801    
 9 Ferna… 2010-01-04       9 104269   3300 L     1.98e7 ESP      188 Q191740    
10 Jo-Wi… 2010-01-04      10 104542   2875 R     1.99e7 FRA      188 Q192661    
# ℹ 144,719 more rows

atp_one <- atp_rank |> filter(name == "Roger Federer")
atp_time <- atp_one |> filter(lubridate::year(ranking_date) >= 2010)

plotFederer <- 
  ggplot(data = atp_time, aes(x = ranking_date, y = points, label = rank)) +
  geom_line() +
  theme_minimal() +
  labs(title = "Ranking Points for Roger Federer") +
  lims(y = c(0, NA))

plotFederer

Question 1 (2 points).

Outside of Shiny, use plotly to add functionality so that, when a user hover’s over Federer’s ranking points plot, his rank at that point in time is shown (and only his rank is shown when hovering).

library(plotly)

Attaching package: 'plotly'

The following object is masked from 'package:ggplot2':

    last_plot

The following object is masked from 'package:stats':

    filter

The following object is masked from 'package:graphics':

    layout

custom_tooltip_text <- atp_time$rank
plotFederer %>%
  ggplotly(tooltip = c("label")) %>%
  layout(hovermode = "x unified", # makes it so line is fixed along the line
         hoverlabel = list(bgcolor = "lightgreen"),
         hoverinfo = "text",
          text = custom_tooltip_text)

Warning: 'layout' objects don't have these attributes: 'hoverinfo', 'text'
Valid attributes include:
'_deprecated', 'activeshape', 'annotations', 'autosize', 'autotypenumbers', 'calendar', 'clickmode', 'coloraxis', 'colorscale', 'colorway', 'computed', 'datarevision', 'dragmode', 'editrevision', 'editType', 'font', 'geo', 'grid', 'height', 'hidesources', 'hoverdistance', 'hoverlabel', 'hovermode', 'images', 'legend', 'mapbox', 'margin', 'meta', 'metasrc', 'modebar', 'newshape', 'paper_bgcolor', 'plot_bgcolor', 'polar', 'scene', 'selectdirection', 'selectionrevision', 'separators', 'shapes', 'showlegend', 'sliders', 'smith', 'spikedistance', 'template', 'ternary', 'title', 'transition', 'uirevision', 'uniformtext', 'updatemenus', 'width', 'xaxis', 'yaxis', 'barmode', 'bargap', 'mapType'

Question 2 (8 points).

Create a shiny app with this data that satisfies the following:

the user should be able to change the player whose ranking points are shown.

the user should be able to adjust the dates of the plot by specifying a start year (so that, for example, they might choose to make the plot start at the year 2015).

the user should be able to change the y-axis so that the y-axis is either points or rank (remember what we discussed about tidy evaluation!). In practice, the points variable is the better one to plot.

the title of the plot should update to show the player that the user has selected.

Note 1: Because the user will select points or rank, you can get rid of the plotly functionality that you completed for exercise 1.

Note 2: It might be helpful practice for the handwritten portion of the assessment to draw a reactive graph of your shiny app after you finish writing it. You do not, however, need to turn in your reactive graph sketch.

library(shiny)

ui <- fluidPage(
  titlePanel("ATP Rankings"),
  sidebarLayout(
    sidebarPanel(
      selectInput("player", "Player", choices = unique(atp_rank$name)),
      sliderInput("year", "Year", min = 2010, max = 2020, 
            value = c(2010, 2020),
            step = 1,
            sep = "",
            timeFormat = "%Y"),
      selectInput("y_axis", "Y-axis", choices = c("points", "rank"))),
    
    mainPanel(
      plotlyOutput("plot")
    )
  )
)

server <- function(input, output) {
  filtered_data <- reactive({
    atp_one <- atp_rank %>%
      filter(name == input$player) %>%
      filter(lubridate::year(ranking_date) >= input$year[1])
    atp_one
  })
  
  output$plot <- renderPlotly({
    p <- ggplot(data = filtered_data(), aes(x = ranking_date, y = .data[[input$y_axis]])) +
      geom_line() +
      theme_minimal() +
      labs(title = paste("Ranking Points for", input$player)) +
      ylim(0, NA)
    
    ggplotly(p, tooltip = c("x", "y")) %>% 
      layout(hovermode = "x unified", # makes it so line is fixed along the line
         hoverlabel = list(bgcolor = "lightgreen"))
  })
}

shinyApp(ui = ui, server = server)

PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.

Listening on http://127.0.0.1:5100